home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / CMPLTPAS / PULLDOWN.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-24  |  20KB  |  491 lines
  1. {--------------------------------------------------------------}
  2. {                         PULLDOWN                             }
  3. {                                                              }
  4. {              Graphics pull-down menuing system               }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 7/24/88              }
  9. {                                                              }
  10. {                                                              }
  11. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  12. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  13. {--------------------------------------------------------------}
  14.  
  15. UNIT PullDown;
  16.  
  17. INTERFACE
  18.  
  19. USES DOS,Graph,Crt,Mouse;  { Mouse is described in Section 17 }
  20.  
  21. TYPE
  22.   String15  = String[15];
  23.  
  24.   ItemRec   = RECORD
  25.                 Item       : String15;  { Title of item }
  26.                 ItemCode   : Byte;      { Code number of item }
  27.                 ItemActive : Boolean    { True if item is active }
  28.               END;
  29.  
  30.   MenuRec   = RECORD
  31.                 XStart,XEnd : Word;     { Pixel offset along menu bar }
  32.                 Title       : String15; { Menu title }
  33.                 MenuSize    : Word;     { Size of menu image on heap }
  34.                 Imageptr    : Pointer;  { Points to menu image on heap }
  35.                 Active      : Boolean;  { True if menu is active }
  36.                 Choices     : Byte;     { Number of items in menu }
  37.                 ItemList    : ARRAY[0..18] OF ItemRec  { The items }
  38.               END;
  39.  
  40.   MenuDesc  = ARRAY[0..12] OF MenuRec;  { Up to 13 items along menu bar }
  41.  
  42.  
  43. {->>>>ActivateMenu<<<<-----------------------------------------}
  44. {                                                              }
  45. { Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
  46. {                                                              }
  47. { This routine makes the menu specified by MenuNumber active,  }
  48. { regardless of whether it was active or inactive at           }
  49. { invocation.  ImagePtr is set to NIL so that the menu will be }
  50. { redrawn the next time it is pulled down.                     }
  51. {                                                              }
  52. { Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
  53. {   predefined.                                                }
  54. {--------------------------------------------------------------}
  55.  
  56. PROCEDURE ActivateMenu(VAR CurrentMenu : MenuDesc;
  57.                        MenuNumber      : Byte);
  58.  
  59.  
  60. {->>>>DeactivateMenu<<<<---------------------------------------}
  61. {                                                              }
  62. { Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
  63. {                                                              }
  64. { This routine makes the menu specified by MenuNumber          }
  65. { inactive, regardless of whether it was active or inactive at }
  66. { invocation.  ImagePtr is set to NIL so that the menu will be }
  67. { redrawn the next time it is pulled down.                     }
  68. {                                                              }
  69. { Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
  70. {   predefined.                                                }
  71. {--------------------------------------------------------------}
  72.  
  73. PROCEDURE DeactivateMenu(VAR CurrentMenu : MenuDesc;
  74.                          MenuNumber      : Byte);
  75.  
  76.  
  77. {->>>>ActivateItem<<<<-----------------------------------------}
  78. {                                                              }
  79. { Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
  80. {                                                              }
  81. { This routine sets the item whose code is given in Code to    }
  82. { active, regardless of the state of the item at invocation.   }
  83. { ImagePtr is set to NIL so that the menu will be redrawn      }
  84. { the next time it is pulled down.                             }
  85. {                                                              }
  86. { Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
  87. {   predefined.                                                }
  88. {--------------------------------------------------------------}
  89.  
  90. PROCEDURE ActivateItem(VAR CurrentMenu : MenuDesc;
  91.                        Code            : Byte);
  92.  
  93.  
  94. {->>>>DeactivateItem<<<<---------------------------------------}
  95. {                                                              }
  96. { Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
  97. {                                                              }
  98. { This routine sets the item whose code is given in Code to    }
  99. { inactive, regardless of the state of the item at invocation. }
  100. { ImagePtr is set to NIL so that the menu will be redrawn      }
  101. { the next time it is pulled down.                             }
  102. {                                                              }
  103. { Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
  104. {   predefined.                                                }
  105. {--------------------------------------------------------------}
  106.  
  107. PROCEDURE DeactivateItem(VAR CurrentMenu : MenuDesc;
  108.                          Code            : Byte);
  109.  
  110.  
  111. {->>>>InvalidMenu<<<<------------------------------------------}
  112. {                                                              }
  113. { Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
  114. {                                                              }
  115. { This function checks for duplicate item codes within the     }
  116. { menu array passed in CurrentMenu.  The menuing system always }
  117. { assumes that every menu item has a unique code.  Run this    }
  118. { function on any menu array you intend to use and abort if a  }
  119. { duplicate code is detected.                                  }
  120. {                                                              }
  121. { Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
  122. {   predefined.                                                }
  123. {--------------------------------------------------------------}
  124.  
  125. FUNCTION InvalidMenu(CurrentMenu : MenuDesc;
  126.                      VAR BadCode : Byte) : Boolean;
  127.  
  128.  
  129.  
  130. {->>>>SetupMenu<<<<--------------------------------------------}
  131. {                                                              }
  132. { Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
  133. {                                                              }
  134. { This routine does the initial display of the menu bar, menu  }
  135. { titles, and the menu bar amulet.                             }
  136. {                                                              }
  137. { Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
  138. {   predefined.                                                }
  139. {--------------------------------------------------------------}
  140.  
  141. PROCEDURE SetupMenu(CurrentMenu : MenuDesc);
  142.  
  143.  
  144.  
  145. {->>>>Menu<<<<-------------------------------------------------}
  146. {                                                              }
  147. { Filename : PULLDOWN.PAS -- Last Modified 12/25/87            }
  148. {                                                              }
  149. { This is the main menuing routine.  It requires that both     }
  150. { InvalidMenu and SetupMenu be run before it.  It directly     }
  151. { samples the mouse pointer position and decides which menu    }
  152. { within the menu bar has been selected.  It then allows the   }
  153. { user to bounce the menu bar up and down within the menu      }
  154. { until an item is chosen or the right button is pressed or    }
  155. { the pointer is moved out of the pulled-down menu.  The code  }
  156. { of the chosen item is returned in ReturnCode.  If no item is }
  157. { chosen, ReturnCode comes returns a 0.  The returned code is  }
  158. { within the range 0-255.                                      }
  159. {                                                              }
  160. { Menu is responsible for drawing pull-down menus and storing  }
  161. { them on the heap so that once drawn a menu does not need to  }
  162. { be drawn again until it is changed somehow, typically by     }
  163. { deactivating or reactivating an item.                        }
  164. {                                                              }
  165. { Types MenuRec, ChoiceRec, MenuDesc and String15 must be      }
  166. {   predefined.                                                }
  167. {--------------------------------------------------------------}
  168.  
  169. PROCEDURE Menu(CurrentMenu    : MenuDesc;
  170.                VAR ReturnCode : Word;
  171.                VAR Amulet     : Boolean);
  172.  
  173.  
  174.  
  175. IMPLEMENTATION
  176.  
  177.  
  178. PROCEDURE ChangeItemStatus(VAR CurrentMenu : MenuDesc;
  179.                            Code            : Byte;
  180.                            ToActive        : Boolean);
  181.  
  182. VAR
  183.   I          : Byte;
  184.   MenuNumber : Byte;
  185.   ItemFound  : Boolean;
  186.  
  187. BEGIN
  188.   MenuNumber := 0; ItemFound := False;
  189.   REPEAT
  190.     WITH CurrentMenu[MenuNumber] DO
  191.       BEGIN
  192.         I := 0;
  193.         REPEAT     { Here we scan menu items to find the right one }
  194.           IF ItemList[I].ItemCode = Code THEN  { We found it ! }
  195.             BEGIN
  196.               ItemList[I].ItemActive := ToActive;  { Mark item }
  197.               ItemFound := True;
  198.               { Since we've changed the information in a menu, we must       }
  199.               {  remove any menu image from storage on the heap, and force   }
  200.               {  the code to redraw the menu the next time it's pulled down: }
  201.               IF ImagePtr <> NIL THEN    { If there's an image on the heap }
  202.                 BEGIN
  203.                   FreeMem(ImagePtr,MenuSize);  { Deallocate the heap image }
  204.                   ImagePtr := NIL              { Make pointer NIL again }
  205.                 END;
  206.             END
  207.           ELSE
  208.             Inc(I)
  209.         UNTIL ItemFound OR (I > Choices)
  210.       END;
  211.     Inc(MenuNumber)
  212.   UNTIL ItemFound OR (MenuNumber > 12);
  213. END;
  214.  
  215.  
  216. {---------------------------------------------------------------------}
  217. {  IMPLEMENTATION Definitions above this bar are PRIVATE to the unit. }
  218. {---------------------------------------------------------------------}
  219.  
  220.  
  221. PROCEDURE ActivateMenu(VAR CurrentMenu : MenuDesc;
  222.                        MenuNumber      : Byte);
  223.  
  224. BEGIN
  225.   WITH CurrentMenu[MenuNumber] DO
  226.     BEGIN
  227.       ImagePtr := NIL;
  228.       Active   := True
  229.     END
  230. END;
  231.  
  232.  
  233. PROCEDURE DeactivateMenu(VAR CurrentMenu : MenuDesc;
  234.                          MenuNumber      : Byte);
  235.  
  236. BEGIN
  237.   WITH CurrentMenu[MenuNumber] DO
  238.     BEGIN
  239.       ImagePtr := NIL;
  240.       Active   := False
  241.     END
  242. END;
  243.  
  244.  
  245.  
  246.  
  247. PROCEDURE ActivateItem(VAR CurrentMenu : MenuDesc;
  248.                        Code            : Byte);
  249.  
  250. BEGIN
  251.   ChangeItemStatus(CurrentMenu,Code,True)
  252. END;
  253.  
  254.  
  255. PROCEDURE DeactivateItem(VAR CurrentMenu : MenuDesc;
  256.                          Code            : Byte);
  257.  
  258. BEGIN
  259.   ChangeItemStatus(CurrentMenu,Code,False)
  260. END;
  261.  
  262.  
  263.  
  264.  
  265. FUNCTION InvalidMenu(CurrentMenu : MenuDesc;
  266.                      VAR BadCode : Byte) : Boolean;
  267.  
  268. VAR
  269.   I,J            : Word;
  270.   CmdSet         : SET OF Byte;
  271.   DuplicateFound : Boolean;
  272.  
  273. BEGIN
  274.   DuplicateFound := False;
  275.   CmdSet := [];  { Start out with the empty set }
  276.   FOR I := 0 TO 12 DO      { Check each menu }
  277.     WITH CurrentMenu[I] DO
  278.       BEGIN
  279.         J := 0;  { Reset item counter to 0 for each new menu }
  280.         REPEAT   { Here we scan menu items to check each one }
  281.           IF ItemList[J].ItemCode > 0 THEN
  282.             IF ItemList[J].ItemCode IN CmdSet THEN
  283.               BEGIN
  284.                 DuplicateFound := True;         { Flag duplicate }
  285.                 BadCode := ItemList[J].ItemCode { Return dupe in BADCODE }
  286.               END
  287.             ELSE
  288.               BEGIN
  289.                 { Add item's command code to the set: }
  290.                 CmdSet := CmdSet + [ItemList[J].ItemCode];
  291.                 Inc(J)
  292.               END
  293.           ELSE Inc(J)
  294.         UNTIL (J > Choices) OR DuplicateFound
  295.       END;
  296.   InvalidMenu := DuplicateFound
  297. END;
  298.  
  299.  
  300.  
  301. PROCEDURE SetupMenu(CurrentMenu : MenuDesc);
  302.  
  303. VAR
  304.   I,DrawX,DrawY : Word;
  305.  
  306. BEGIN
  307.   { Show bar and amulet: }
  308.   SetFillStyle(SolidFill,White); Bar(0,0,GetMaxX,11);
  309.   SetColor(0); Rectangle(2,1,12,9);
  310.   FOR I := 3 TO 8 DO IF Odd(I) THEN Line(4,I,10,I);
  311.  
  312.   { Display menu titles in bar: }
  313.   DrawX := CurrentMenu[0].XStart; DrawY := 2; I := 0;
  314.   REPEAT
  315.     OutTextXY(DrawX,DrawY,CurrentMenu[I].Title);
  316.     Inc(I);
  317.     DrawX := CurrentMenu[I].XStart;
  318.   UNTIL (Length(CurrentMenu[I].Title) = 0) OR (I > 13);
  319. END;
  320.  
  321.  
  322. PROCEDURE Menu(CurrentMenu    : MenuDesc;
  323.                VAR ReturnCode : Word;
  324.                VAR Amulet     : Boolean);
  325.  
  326. VAR
  327.   PointerX,PointerY : Word;       { Current position of mouse pointer }
  328.   Left,Center,Right : Boolean;    { Current state of mouse buttons }
  329.   I,J               : Integer;
  330.   MenuWidth         : Integer;    { Width in pixels of target menu }
  331.   M1X,M1Y,M2X,M2Y   : Integer;    { Coordinates of menu box }
  332.   FoundMenu         : Boolean;
  333.   SaveColor         : Integer;    { Holds caller's draw color }
  334.   UnderMenu         : Pointer;    { Points to saved screen area }
  335.   BounceBar         : Pointer;    { Points to bounce bar pattern }
  336.   Pick              : Word;       { Number of item under bounce bar }
  337.   UpperBound,
  338.     LowerBound      : Integer;    { Current Y-limits of bounce bar }
  339.  
  340.  
  341. PROCEDURE RestoreUnderMenuBox;
  342.  
  343. BEGIN
  344.   PointerOff;
  345.   PutImage(M1X,M1Y,UnderMenu^,NormalPut);
  346.   PointerOn
  347. END;
  348.  
  349.  
  350. BEGIN
  351.   Amulet := False;
  352.   SaveColor := GetColor; SetColor(White);
  353.   PollMouse(PointerX,PointerY,Left,Right,Center);
  354.   { Check to see if the amulet is under mouse pointer: }
  355.   IF (PointerX > 1) AND (PointerX < 13) AND
  356.      (PointerY > 0) AND (PointerY < 10)
  357.   THEN
  358.     BEGIN
  359.       Amulet := True;   { We've clicked on the amulet }
  360.       SetColor(SaveColor);
  361.       Exit              { THIS IS AN EXIT TO MENU! }
  362.     END;
  363.   { Now we find out which menu to pull down: }
  364.   I := -1;
  365.   REPEAT
  366.     I := I + 1;
  367.     IF (PointerX >= CurrentMenu[I].XStart) AND  { If pointer is in }
  368.        (PointerX <= CurrentMenu[I].XEnd)   AND  { menu's range }
  369.        CurrentMenu[I].Active                    { and menu is active }
  370.     THEN FoundMenu := True ELSE FoundMenu := False;
  371.   UNTIL FoundMenu OR                           { We hit an active menu }
  372.         (Length(CurrentMenu[I].Title) = 0) OR  { We hit a null menu }
  373.         (I > 13);                              { Only 13 menus max! }
  374.   IF FoundMenu THEN  { Pull it down and pick! }
  375.     BEGIN
  376.       PointerOff;
  377.       WITH CurrentMenu[I] DO   { We're only working with current menu now }
  378.         BEGIN
  379.           { Calc coordinates of the found menu box: }
  380.           MenuWidth := 0;       { First we have to calc menu width : }
  381.           FOR J := 0 TO Choices-1 DO  { Find longest item string }
  382.             IF Length(ItemList[J].Item) > MenuWidth
  383.               THEN MenuWidth := Length(ItemList[J].Item);
  384.           MenuWidth := MenuWidth * 8; { We're using the 8 X 8 font }
  385.           M1X := XStart; M1Y := 11;
  386.           M2X := XStart+MenuWidth+6;
  387.           M2Y := (Choices+1) * 12;
  388.           MenuSize := ImageSize(M1X,M1Y,M2X,M2Y);
  389.  
  390.           { We must save the screen area beneath the menu box: }
  391.           GetMem(UnderMenu,MenuSize);            { Allocate space on heap }
  392.           GetImage(M1X,M1Y,M2X,M2Y,UnderMenu^);  { Save area out to heap  }
  393.  
  394.           { First we clear the menu box: }
  395.           SetFillStyle(SolidFill,Black);
  396.           Bar(M1X,M1Y,M2X,M2Y);
  397.  
  398.           { Here we create the bounce bar pattern on the heap: }
  399.           SetFillStyle(SolidFill,White);
  400.           GetMem(BounceBar,ImageSize(M1X+1,M1Y+1,M2X-1,M1Y+12));
  401.           Bar(M1X+1,M1Y+1,M2X-1,M1Y+12);
  402.           GetImage(M1X+1,M1Y+1,M2X-1,M1Y+12,BounceBar^);
  403.  
  404.           { If the menu has not yet been shown for the first time, or if    }
  405.           {   the active/inactive status of any menu item has changed since }
  406.           {   we last pulled it down, the image pointer is NIL and we must  }
  407.           {   draw it and then store it on the heap.  Any time AFTER the    }
  408.           {   first time it comes in from the heap with lightning speed...  }
  409.           IF ImagePtr = NIL THEN    { We must draw the menu }
  410.             BEGIN
  411.               Rectangle(M1X,M1Y,M2X,M2Y);  { Draw the menu box }
  412.               { The first item must be drawn in black on the white bar: }
  413.               SetColor(Black);
  414.               IF ItemList[0].ItemActive THEN
  415.                 OutTextXY(XStart+3,14,ItemList[0].Item);
  416.               SetColor(White);
  417.               { Items after the first are drawn in white on black: }
  418.               FOR J := 1 TO Choices-1 DO IF ItemList[J].ItemActive THEN
  419.                 OutTextXY(XStart+3,14+(J*12),ItemList[J].Item);
  420.               { Now we allocate heap space and move image to heap }
  421.               GetMem(ImagePtr,MenuSize);
  422.               GetImage(M1X,M1Y,M2X,M2Y,ImagePtr^);
  423.             END;
  424.  
  425.           { Bring the menu box image in from the heap: }
  426.           PutImage(M1X,M1Y,ImagePtr^,NormalPut);
  427.           PointerOn;  { We need the pointer on to bounce the bar }
  428.  
  429.           { Now we enter the "bounce loop" that moves the bounce bar  }
  430.           {  up and down the menu box, attached to the mouse pointer: }
  431.           UpperBound := 12; LowerBound := 24; Pick := 0;
  432.           REPEAT
  433.             PollMouse(PointerX,PointerY,Left,Center,Right);
  434.             { If the pointer leaves the menu box, it's an "escape" }
  435.             {   identical in effect to pressing the right button:  }
  436.             IF (PointerX < M1X) OR (PointerX > M2X) OR
  437.                (PointerY > M2Y) THEN Right := True
  438.             ELSE
  439.               BEGIN
  440.               IF PointerY < UpperBound THEN   { We bounce the bar UPWARD: }
  441.                 IF PointerY > 12 THEN   { If we're not above the top line }
  442.                   BEGIN
  443.                     PointerOff;
  444.                     { Erase bar at current position if item is active: }
  445.                     IF ItemList[Pick].ItemActive THEN
  446.                       PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
  447.                     { Decrement bounds and pick number: }
  448.                     UpperBound := UpperBound - 12;
  449.                     LowerBound := LowerBound - 12;
  450.                     Pick := Pick - 1;
  451.                     { Show bar at new position if item is active: }
  452.                     IF ItemList[Pick].ItemActive THEN
  453.                       PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
  454.                     PointerOn;
  455.                   END;
  456.               IF PointerY > LowerBound THEN
  457.                 BEGIN
  458.                   PointerOff;
  459.                   { Erase bar at current position if item is active: }
  460.                   IF ItemList[Pick].ItemActive THEN
  461.                     PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
  462.                   { Increment bounds and pick number: }
  463.                   UpperBound := UpperBound + 12;
  464.                   LowerBound := LowerBound + 12;
  465.                   Pick := Pick + 1;
  466.                   { Show bar at new position if item is active: }
  467.                   IF ItemList[Pick].ItemActive THEN
  468.                     PutImage(M1X+1,UpperBound,BounceBar^,XORPut);
  469.                   PointerOn;
  470.                 END;
  471.               END;
  472.           UNTIL (NOT Left) OR Right;
  473.           RestoreUnderMenuBox;
  474.           { Now we set up the function return code.  The right button  }
  475.           { always indicates "escape;" i.e., 0; Take No Action.        }
  476.           { Picking an inactive menu item also returns a 0.  An active }
  477.           { item returns its item code as the function result. }
  478.           IF Right THEN ReturnCode := 0
  479.             ELSE IF ItemList[Pick].ItemActive THEN
  480.                     ReturnCode := ItemList[Pick].ItemCode
  481.                  ELSE ReturnCode := 0
  482.         END;  { WITH statement }
  483.       PointerOn;
  484.     END;
  485.   SetColor(SaveColor);   { Restore caller's drawing color }
  486. END;
  487.  
  488. { No initialization section...}
  489.  
  490. END.
  491.